MacFormat 1994 November/macformat-018.iso/Utility Spectacular/Developer/hex Folder/Hex.p

Text File | 1992-09-30 | 16.7 KB | 590 lines | [TEXT/MPS ]

 {=============================================================================

 FILE Hex.p

 NAME
    Hex -- reads a resource from a file and converts it to raw/Intel/Motorola hex format.

 SYNOPSIS
    Hex file [-p] [-a address] [-h hextype] [-m hexmode] [-r rType] [-i rID] [-s skip]

 DESCRIPTION
    Hex converts a resource to an ASCII HEX file.

 OPTIONS
    -p     Writes progress information to diagnostic output (default: no progress info)
    -a     Specify start address of output file (default: 0)
    -h     Hex type: raw|intel|s1|s2|s3 (default: intel)
    -m     Hex mode: all|even|odd (default: all)
    -r     Resource type (default: CODE)
    -i     Resource ID (default: 1)
    -s     No of bytes to skip at start of resource (default: 4)

    Note:  Numeric options may be specified in decimal (nnn) or hex ($nnn)

 DIAGNOSTICS
    0 Normal termination.
    1 Syntax error.
    2 Resource file not found.
    3 Resource not found.
    4 Execution aborted.

 MODIFICATION HISTORY
     4/10/87 Added odd/even byte splitting
                     Added start address dialog
                     Added code size to conversion dialog
                     Improved format of conversion dialog
    12/10/87 Opens files of type 'CODE' or 'DATA' in addition to 'APPL'
    28/01/88 Converted to MPW 2.0.2, Pascal 2.0.2
    23/10/88 Converted to MPW Tool
    15/12/88 Upgraded to MPW 3.0b1
        6/5/90 Upgraded to MPW 3.1
     30/9/92 Upgraded to MPW 3.3
                     Tidied up for release

 KNOWN BUGS
    Can only handle CODE resources up to 32k bytes
    Doesn't check for APPL's which might already be open (eg. under MultiFinder)
    Motorola S3 (32 bit addresses) probably don't work for addresses > $7FFFFFFF (we use a LongInt for address)

 Copyright Paul Russell, ARC Electronics, 1987-1992.

 =============================================================================}

PROGRAM Hex;

    USES Memtypes, Quickdraw, OSIntf, ToolIntf, PackIntf, { Mac interface }
             CursorCtl, { spinning cursor }
             Signal, { command-period handling }
             PasLibIntf, { standard I/O etc }
             IntEnv; { argV and argC }

    CONST
        Version = '1.021'; { MPW version resource (used by SetVersion Tool) }
        kNull = ''; { null string }
        kSpace = ' '; { space character }
        kMaxCodeSize = MAXINT; { the biggest code resource we can handle }

    TYPE
        Str1 = STRING[1];

        Code = PACKED ARRAY [0..kMaxCodeSize] OF Byte;
        CodePtr = ^Code;
        CodeHandle = ^CodePtr;

        HexTypes = (raw, intel, motorolaS1, motorolaS2, motorolaS3);
        HexModes = (allBytes, evenBytes, oddBytes);

        RetCodes = (RC_Normal, RC_ParmErrs, RC_FileNotFound, RC_ResNotFound, RC_Abort); { return codes }

        Nybble = 0..15;

    VAR
        codeH: CodeHandle; { handle to our CODE resource }
        progress: Boolean; { progress info on diagnostic file }
        address: LongInt; { start address }
        hexType: HexTypes; { hex type, raw/intel/s1/s2/s3 }
        hexMode: HexModes; { hex mode, all/even/odd bytes }
        rType: ResType; { resource type }
        rID: INTEGER; { resource ID }
        skip: INTEGER; { no of bytes to skip at start of resource }
        fileRef: INTEGER; { the refnum for our file }
        fileName: Str255; { the name of the file we're HEX'ing }
        progName: Str255; { program file name }
        interrupted: Boolean; { interrupted (Command-. pressed) }
        retCode: RetCodes; { return codes }

        {=== ToUpper - convert string to upper case ===}

    FUNCTION ToUpper(st: Str255): Str255;

        VAR
            i: INTEGER;
            ch: Char;

        BEGIN
            FOR i := 1 TO Length(st) DO
                BEGIN
                ch := st[i];
                IF ch IN ['a'..'z'] THEN
                    BEGIN
                    ch := Chr(Ord(ch) - Ord('a') + Ord('A'));
                    st[i] := ch;
                    END;
                END;
            ToUpper := st; { return upper case string }
        END; { ToUpper }

    {=== HexChar - convert a nybble to a hexadecimal character ===}

    FUNCTION HexChar(i: Nybble): Char;

        CONST
            hexChars = '0123456789ABCDEF';

        BEGIN { HexChar }
            HexChar := hexChars[i + 1];
        END; { HexChar }

    {=== NumToHexString - hex version of NumToString - only works for 0 <= i <= MAXLONGINT ===}

    PROCEDURE NumToHexString(num: LongInt;
                                                     VAR st: Str255);

        VAR
            digit: INTEGER;
            st1: Str1;

        BEGIN { NumToHexString }
            IF num <= 0 THEN
                st := '0'
            ELSE
                BEGIN
                st := kNull;
                st1 := kSpace;
                WHILE num > 0 DO
                    BEGIN
                    st1[1] := HexChar(num MOD $10);
                    st := concat(st1, st);
                    num := num DIV $10;
                    END;
                END;
        END; { NumToHexString }

    {=== HexStringToNum - hex version of StringToNum ===}

    PROCEDURE HexStringToNum(st: Str255;
                                                     VAR num: LongInt);

        VAR
            i, digit: INTEGER;
            digitFound: Boolean;
            ch: Char;

        BEGIN { HexStringToNum }
            num := 0;
            digitFound := FALSE;
            FOR i := 1 TO Length(st) DO { for each character in the string }
                BEGIN
                ch := st[i]; { get the character }
                IF ch IN ['0'..'9'] THEN { if decimal }
                    BEGIN
                    digit := Ord(ch) - Ord('0');
                    digitFound := TRUE;
                    END
                ELSE
                    IF ch IN ['A'..'F'] THEN { if upper case hex letter }
                        BEGIN
                        digit := Ord(ch) - Ord('A') + 10;
                        digitFound := TRUE;
                        END
                    ELSE
                        IF ch IN ['a'..'f'] THEN { if lower case hex letter }
                            BEGIN
                            digit := Ord(ch) - Ord('a') + 10;
                            digitFound := TRUE;
                            END
                        ELSE
                            IF digitFound THEN { if we've just run out of valid chars }
                                Exit(HexStringToNum); { exit }
                IF digitFound THEN { if we have a valid char }
                    num := num * $10 + digit; { shift number left one digit and add new digit }
                END;
        END; { HexStringToNum }

    {=== Stop - terminate execution ===}

    PROCEDURE Stop(msg: Str255);

        BEGIN { Stop }
            IF Length(msg) > 0 THEN
                BEGIN
                PLFlush(Output);
                WriteLn(Diagnostic);
                WriteLn(Diagnostic, msg);
                END;
            IF interrupted THEN retCode := RC_Abort;
            { don't worry about closing the files we opened - the Shell will do so if appropriate }
            IF codeH <> NIL THEN { if we have allocated memory for our CODE resource }
                BEGIN
                HUnLock(Handle(codeH)); { unlock it }
                DisposHandle(Handle(codeH)); { dispose of it }
                END;
            IEexit(Ord(retCode)); { exit, returning the appropriate status code }
        END; { Stop }

    {=== Intr - Process external interrupt - this routine is passed to IEsigset ===}

    PROCEDURE Intr;

        BEGIN { Intr }
            interrupted := TRUE; { we test this switch periodically }
        END; { Intr }

    {$S Init }

    {=== SyntaxError - Report an error in parameters or options ===}

    PROCEDURE SyntaxError(message: Str255);

        BEGIN
            PLFlush(Output);
            WriteLn(Diagnostic, '### ', progName, ' - ', message);
            Stop(concat('# Usage: ', progName, ' file [-p] [-a address] [-h hextype] [-m hexmode] [-r rType] [-i rID] [-s skip]'));
        END;

    {=== GetNumArg - Get an INTEGER argument after a letter option ===}

    FUNCTION GetNumArg(VAR ArgVIndex: INTEGER;
                                         Name: Str255;
                                         Low, High: LongInt): LongInt;

        VAR
            num: LongInt;
            i: INTEGER;

        BEGIN
            i := ArgVIndex + 1; { get index of numeric argument }
            IF i >= ArgC THEN { if we've run out of parameters }
                SyntaxError(concat('The "', ArgV^[ArgVIndex]^, '" option requires a numeric parameter'));
            IF ArgV^[i]^[1] = '$' THEN { if arg has a leading $ }
                HexStringToNum(ArgV^[i]^, num) { convert hex string }
            ELSE
                StringToNum(ArgV^[i]^, num); { convert decimal string }
            IF (num < Low) OR (num > High) THEN { check range }
                BEGIN
                WriteLn(Diagnostic, '### ', progName, ' - ', '"', ArgV^[ArgVIndex]^, '" option requires ', Low, ' <= ', Name, ' <= ', High, '.');
                SyntaxError(kNull);
                END;
            ArgVIndex := i; { update argV index }
            GetNumArg := num; { return the value }
        END; { GetNumArg }

    {=== GetAlphaArg - Get a string argument after a letter option ===}

    FUNCTION GetAlphaArg(VAR ArgVIndex: INTEGER): Str255;

        VAR
            i: INTEGER;

        BEGIN
            i := ArgVIndex + 1; { get index of numeric argument }
            IF i >= ArgC THEN { if we've run out of parameters }
                SyntaxError(concat('The "', ArgV^[ArgVIndex]^, '" option requires an alphanumeric parameter'));
            ArgVIndex := i; { update argV index }
            GetAlphaArg := ArgV^[i]^; { return the string }
        END; { GetAlphaArg }

    {=== LetterOpt - Set a letter option ===}

    PROCEDURE LetterOpt(opt: Char;
                                            VAR ArgVIndex: INTEGER);

    { ArgVIndex is passed to this routine so options that have arguments can 'eat' them }

        VAR
            st: Str255;
            i: INTEGER;

        BEGIN { LetterOpt }
            CASE opt OF
                'p', 'P': progress := TRUE;
                'a', 'A': address := GetNumArg(ArgVIndex, 'address', - MAXLONGINT, MAXLONGINT);
                'h', 'H':
                    BEGIN
                    st := ToUpper(GetAlphaArg(ArgVIndex));
                    IF st = 'RAW' THEN
                        hexType := raw
                    ELSE
                        IF st = 'INTEL' THEN
                            hexType := intel
                        ELSE
                            IF st = 'S1' THEN
                                hexType := motorolaS1
                            ELSE
                                IF st = 'S2' THEN
                                    hexType := motorolaS2
                                ELSE
                                    IF st = 'S3' THEN
                                        hexType := motorolaS3
                                    ELSE
                                        SyntaxError(concat(ArgV^[ArgVIndex]^, ' <invalid hex type>'));
                    END;
                'm', 'M':
                    BEGIN
                    st := ToUpper(GetAlphaArg(ArgVIndex));
                    IF st = 'ALL' THEN
                        hexMode := allBytes
                    ELSE
                        IF st = 'EVEN' THEN
                            hexMode := evenBytes
                        ELSE
                            IF st = 'ODD' THEN
                                hexMode := oddBytes
                            ELSE
                                SyntaxError(concat(ArgV^[ArgVIndex]^, ' <invalid hex mode>'));
                    END;
                'r', 'R':
                    BEGIN
                    st := GetAlphaArg(ArgVIndex);
                    IF Length(st) <> 4 THEN SyntaxError(concat(ArgV^[ArgVIndex]^, ' <invalid resource type>'));
                    FOR i := 1 TO 4 DO rType[i] := st[i];
                    END;
                'i', 'I': rID := GetNumArg(ArgVIndex, 'resid', - MAXINT, MAXINT);
                's', 'S': skip := GetNumArg(ArgVIndex, 'skip', 0, MAXLONGINT);
                OTHERWISE SyntaxError(concat(ArgV^[ArgVIndex]^, ' <invalid option>'));
            END;
        END; { LetterOpt }

    {=== Init - Tool initalization ===}

    PROCEDURE Init;

        VAR
            ArgVIndex, fileCount: INTEGER;
            prevSig: SignalHandler;
            arg: Str255;
            h: Handle;

        BEGIN { Init }
            retCode := RC_Normal;
            interrupted := FALSE; { becomes TRUE when interrupted }
            prevSig := IEsignal(SIGINT, @Intr);
            progName := ArgV^[0]^;
            progress := FALSE; { set up default options }
            address := 0;
            hexType := intel;
            hexMode := allBytes;
            rType := 'CODE';
            rID := 1;
            skip := 4;
            codeH := NIL;
            retCode := RC_ParmErrs;
            fileCount := 0;
            fileRef := - 1; { so we tell if the open works }
            ArgVIndex := 1;
            WHILE ArgVIndex < ArgC DO { ArgC is the number of args plus one }
                BEGIN
                arg := ArgV^[ArgVIndex]^;
                IF (Length(arg) <> 0) THEN
                    BEGIN
                    IF arg[1] = '-' THEN { we have an option }
                        LetterOpt(arg[2], ArgVIndex)
                    ELSE { it must be a file to open }
                        BEGIN
                        fileCount := fileCount + 1;
                        fileName := arg;
                        END;
                    END;
                ArgVIndex := ArgVIndex + 1;
                END;
            IF fileCount < 1 THEN SyntaxError('Resource file must be specified');
            IF fileCount > 1 THEN SyntaxError('Too many resource files specified');
            retCode := RC_FileNotFound;
            SetResLoad(FALSE); { prevent preloads }
            fileRef := OpenResFile(fileName); { open resource file }
            SetResLoad(TRUE);
            IF fileRef < 0 THEN
                Stop(concat('### ', progName, ' - could not open ', fileName))
            ELSE
                BEGIN
                retCode := RC_ResNotFound;
                h := Get1Resource(rType, rID); { get the resource }
                IF h = NIL THEN
                    Stop(concat('### ', progName, ' - could not load resource'))
                ELSE
                    BEGIN
                    DetachResource(h);
                    HNoPurge(h); { make sure it doesn't get purged }
                    HUnLock(h); { make sure it's relocatable until we need it }
                    CloseResFile(fileRef);
                    codeH := CodeHandle(h);
                    END;
                END;
            retCode := RC_Normal;
            IF progress THEN
                BEGIN
                WriteLn(Diagnostic);
                WriteLn(Diagnostic, progName, ' (Version ', Version, ')');
                WriteLn(Diagnostic);
                WriteLn(Diagnostic, 'file name     = ', fileName);
                WriteLn(Diagnostic, 'address       = ', address: 8);
                WriteLn(Diagnostic, 'hex type      = ', Ord(hexType): 8);
                WriteLn(Diagnostic, 'hex mode      = ', Ord(hexMode));
                WriteLn(Diagnostic, 'resource type = ', rType: 8);
                WriteLn(Diagnostic, 'resource ID   = ', rID: 8);
                WriteLn(Diagnostic, 'skip          = ', skip: 8);
                WriteLn(Diagnostic);
                END;
        END; { Init }

    {$S Main }

    {=== DoIt - the guts of the program ===}

    PROCEDURE DoIt;

        VAR
            cursorCount: INTEGER; { for our spinning cursor }

        PROCEDURE DoHex;

            VAR
                codeP: CodePtr;
                oSt: Str255;
                b, inBytes, outBytes, maxBytes, cs, dummy: INTEGER;
                done: Boolean;
                err: OSErr;
                codeByte: Byte;
                addr, i, iMax, codeSize: LongInt;
                st1, st2: Str255;

            FUNCTION HexString(ndigits: INTEGER;
                                                 i: LongInt): Str255;

                VAR
                    st: Str255;
                    st1: Str1;

                BEGIN { HexString }
                    st := kNull;
                    st1 := kSpace;
                    WHILE ndigits > 0 DO
                        BEGIN
                        st1[1] := HexChar(i MOD $10); { convert least sig digit to string }
                        st := concat(st1, st); { put digit on front of string }
                        i := i DIV $10; { shift everything right one digit }
                        ndigits := ndigits - 1; { reduce the digit count }
                        END;
                    HexString := st;
                END; { HexString }

            BEGIN { DoHex }
                codeSize := GetHandleSize(Handle(codeH)); { get size of code resource }
                IF progress THEN
                    BEGIN
                    WriteLn(Diagnostic, 'resource size = ', codeSize: 8);
                    WriteLn(Diagnostic);
                    END;
                CASE hexType OF
                    raw, intel: ; { no preamble for raw or Intel format }
                    motorolaS1, motorolaS2, motorolaS3: WriteLn('S0030000FC'); { standard preamble for Motorola formats }
                END;
                HLock(Handle(codeH)); { lock down our CODE resource }
                codeP := codeH^; { de-reference it for speed }
                iMax := codeSize - 1; { get max index }
                done := FALSE;
                addr := address;
                CASE hexMode OF
                    allBytes:
                        BEGIN
                        i := skip; { skip first N bytes }
                        maxBytes := 32;
                        END;
                    evenBytes:
                        BEGIN
                        IF Odd(skip) THEN
                            i := skip + 1 { skip first N bytes + 1 }
                        ELSE
                            i := skip; { skip first N bytes }
                        maxBytes := 64;
                        END;
                    oddBytes:
                        BEGIN
                        IF Odd(skip) THEN
                            i := skip { skip first N bytes + 1 }
                        ELSE
                            i := skip + 1; { skip first N bytes + 1 }
                        maxBytes := 64;
                        END;
                END;
                REPEAT
                    IF interrupted THEN Stop(kNull);
                    RotateCursor(cursorCount);
                    cursorCount := cursorCount + 2;
                    IF (iMax - i) < maxBytes THEN
                        BEGIN
                        inBytes := iMax - i + 1;
                        done := TRUE;
                        END
                    ELSE
                        inBytes := maxBytes;
                    CASE hexMode OF
                        allBytes: outBytes := inBytes;
                        evenBytes, oddBytes: outBytes := (inBytes + 1) DIV 2;
                    END;
                    IF outBytes > 0 THEN
                        BEGIN
                        CASE hexType OF
                            raw: oSt := kNull;
                            intel:
                                BEGIN
                                addr := addr MOD $10000; { 16 bit addresses }
                                oSt := concat(':', HexString(2, outBytes), HexString(4, addr), '00');
                                cs := outBytes + (addr DIV $100) + (addr MOD $100); { init checksum }
                                END;
                            motorolaS1:
                                BEGIN
                                addr := addr MOD $10000; { 16 bit addresses }
                                oSt := concat('S1', HexString(2, outBytes + 3), HexString(4, addr));
                                cs := outBytes + 3 + (addr DIV $100) + (addr MOD $100); { init checksum }
                                END;
                            motorolaS2:
                                BEGIN
                                addr := addr MOD $1000000; { 24 bit addresses }
                                oSt := concat('S2', HexString(2, outBytes + 4), HexString(6, addr));
                                cs := outBytes + 4 + (addr DIV $10000) + (addr DIV $100) + (addr MOD $100); { init checksum }
                                END;
                            motorolaS3:
                                BEGIN
                                oSt := concat('S3', HexString(2, outBytes + 5), HexString(8, addr));
                                cs := outBytes + 5 + (addr DIV $1000000) + (addr DIV $10000) + (addr DIV $100) + (addr MOD $100); { init checksum }
                                END;
                        END;
                        FOR b := 1 TO outBytes DO
                            BEGIN
                            codeByte := codeP^[i]; { get next byte }
                            CASE hexMode OF
                                allBytes: i := i + 1; { bump index to next byte }
                                evenBytes, oddBytes: i := i + 2;
                            END;
                            oSt := concat(oSt, HexString(2, codeByte)); { add to output string }
                            cs := cs + codeByte; { bump checksum calculation }
                            END;
                        IF hexType IN [intel, motorolaS1, motorolaS2, motorolaS3] THEN { if we need a checksum }
                            BEGIN
                            cs := cs MOD $100; { use only least sig 8 bits for checksum }
                            IF hexType = intel THEN { fix checksum according to hex type }
                                cs := $100 - cs { Intel checksum }
                            ELSE
                                cs := $FF - cs; { Motorola checksum }
                            oSt := concat(oSt, HexString(2, cs)); { append checksum }
                            END;
                        WriteLn(oSt);
                        addr := addr + outBytes;
                        END;
                UNTIL done;
                CASE hexType OF
                    intel: WriteLn(':00000001FF');
                    motorolaS1: WriteLn('S9030000FC');
                    motorolaS2: WriteLn('S804000000FB');
                    motorolaS3: WriteLn('S70500000000FA');
                END;
                HUnLock(Handle(codeH)); { unlock our code resource }
                DisposHandle(Handle(codeH)); { dispose of it }
            END; { DoHex }

        BEGIN { DoIt }
            cursorCount := 0; { prepare to spin the cursor }
            DoHex;
            Stop(kNull);
        END; { DoIt }

    {=== Hex - main program ===}

    BEGIN
        Init; { sets up world, opens our resource file }
        UnLoadSeg(@Init); { release our initialization segment }
        DoIt; { and call our main routine }
    END.